home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir30
/
drftls.zip
/
MAKEBDR.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1993-10-03
|
4KB
|
136 lines
; DrafTools [Version 1.00] 9/25/93
;
; ***************************************
; **** Author: Owen Wengerd ****
; **** ****
; **** Manu-Soft Computer Services ****
; **** P.O. Box 84 ****
; **** Fredericksburg, OH 44627 ****
; **** (216) 695-5903 ****
; **** Compu-Serve ID: 71324,3252 ****
; ***************************************
(defun C:MAKEBDR (/ tmp errexit makebdrx fpath
dlg_retcode dcl_id xdos_loaded)
' *** Local Functions ***
(defun errexit (s)
(princ "\nError: ")
(princ s)
(restore)
)
(defun makebdrx ()
(if (tblsearch "VIEW" "TEMP")
(command "_VIEW" "_R" "TEMP" "_VIEW" "_D" "TEMP" "_UCS" "_P")
)
(setvar "CMDECHO" oldvar)
(or
(not xdos_loaded)
(= T xdos_loaded)
(xunload "xdos_dt" nil)
(princ "\n**Cannot unload XDOS_DT from memory**\n ")
)
(setq *error* olderr)
(princ)
)
(defun fpath (filename / path)
(if
(and
*DT_PATH
(setq path
(findfile
(strcat
*DT_PATH
(if (= "\\" (substr *DT_PATH (strlen *DT_PATH) 1)) "" "\\")
filename
)
)
)
)
path
(findfile filename)
)
)
;***********************************************
;*************** Main Program ****************
;***********************************************
(setq T (not nil))
(setq olderr *error*
restore makebdrx
*error* errexit
)
(setq oldvar (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(terpri)
(if
(and
(or
(setq xdos_loaded (= 'EXSUBR (type dt_dosdir)))
(setq xdos_loaded (if (setq tmp (fpath "xdos_dt.exp")) (xload tmp nil)))
)
(setq dcl_id (if (setq tmp (fpath "MAKEBDR.DCL")) (load_dialog tmp)))
)
(progn
(command "_VIEW" "_S" "TEMP" "_UCS" "")
(setq dlg_retcode 6)
(while (and (> dlg_retcode 1) (new_dialog "MAKEBDR" dcl_id))
(setq dlg_retcode (start_dialog))
(cond
( (= 2 dlg_retcode)
(if (setq tmp (getpoint "\n \nPick Insertion Point: "))
(command "_MOVE" "_ALL" "" tmp '(0 0 0) "_ZOOM" "_E")
)
)
( (= 3 dlg_retcode)
(if C:RE-ORDER
(C:RE-ORDER)
(if
(and
(setq tmp (fpath "RE-ORDER.LSP"))
(load tmp)
)
(C:RE-ORDER)
(alert
(strcat "Cannot find file 'RE-ORDER.LSP'"
"\n in current search path!"
)
)
)
)
)
( (= 1 dlg_retcode)
(if
(setq tmp
(getfiled "Enter Border Name" (getvar "DWGNAME") "BDR" 3)
)
(progn
(dt_dosdeletefile "TEMPBDR.DWG")
(command "WBLOCK" "TEMPBDR" "*")
(dt_dosdeletefile tmp)
(dt_dosrename "TEMPBDR.DWG" tmp)
)
)
)
)
)
)
(alert
(if xdos_loaded
(strcat
"Dialog Box Definition File 'INSTITLE.DCL' not Found"
"\n Cannot Continue!"
)
"ADS Application 'XDOS_DT.EXP' not Found\n Cannot Continue!"
)
)
)
(restore)
)